COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "TMP"
C00003 00003	α CRE LINKS & DATUMS
C00005 00004	SUBR PDPY (ITG PGN)		α POLYGON DISPLAY
C00012 00005	SUBR FLMDPY			α FILM DISPLAY
C00013 00006	α INPUT CRE NODES
C00015 ENDMK
C⊗;
BEGIN "TMP"

	REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
	REQUIRE "SAITRG[SYS,BGB]" SOURCE_FILE;
	REQUIRE "DPYIII[SYS,BGB]" SOURCE_FILE;
	SAFE ITG ARRAY DPYBUF[1:1000];
	DEFINE MAG="(32/9)";
	ITG FLG,SIZE,ORIG;STRING STR;

α FILE OPENING & SIZE INPUT;
	OPEN(1,"DSK",8,3,0,0,0,0);
	DO ⊂ OUTSTR(9&"CRE FILE = ");
	STR←INCHWL;LOOKUP(1,STR,FLG);
	IF FLG THEN LOOKUP(1,STR&".CRE",FLG);
	⊃ UNTIL ¬FLG;
	SIZE ← WORDIN(1);

α MAIN EXECUTION BLOCK;
BEGIN "MAIN"
	SAFE ITG ARRAY NODE[0:SIZE];

α CRE LINKS & DATUMS;

	DEFINE CW(Q)	=	"(NODE[Q+0]LSH -18)";
	DEFINE CCW(Q)	=	"(NODE[Q+0]LAND '777777)";

	DEFINE DAD(Q)	=	"(NODE[Q+1]LSH -18)";
	DEFINE SON(Q)	=	"(NODE[Q+1]LAND '777777)";

	DEFINE ROW(Q)	=	"((NODE[Q+3]LSH -18)/64)";
	DEFINE COL(Q)	=	"((NODE[Q+3]LAND '777777)/64)";

	DEFINE ALT(Q)	=	"(NODE[Q+4]LSH -18)";

REAL SUBR AREA (ITG SHAPE);	S⊂ MOVE 2,SHAPE;ADD 2,ORIG;HRLE 1,1(2);⊃;
REAL SUBR PERM (ITG SHAPE);	S⊂ MOVE 2,SHAPE;ADD 2,ORIG;HLLE 1,1(2);⊃;

REAL SUBR PXY  (ITG SHAPE);	S⊂ MOVE 2,SHAPE;ADD 2,ORIG;HLLE 1,4(2);⊃;

REAL SUBR MXX  (ITG SHAPE);	S⊂ MOVE 2,SHAPE;ADD 2,ORIG;HLLE 1,6(2);⊃;
REAL SUBR MYY  (ITG SHAPE);	S⊂ MOVE 2,SHAPE;ADD 2,ORIG;HRLE 1,6(2);⊃;
REAL SUBR MZZ  (ITG SHAPE);	S⊂ MOVE 2,SHAPE;ADD 2,ORIG;HRLE 1,4(2);⊃;

REAL SUBR PHI  (ITG S);		RETURN(0.5*ATAN2(MYY(S)-MXX(S),2*PXY(S)));
SUBR PDPY (ITG PGN);		α POLYGON DISPLAY;
BEGIN "PDPY"
	ITG V0,V,S;
	
α TEST SHAPE NODE FOR QUEUE BALL OUTLINE;
	S ← ALT(PGN);
	IF AREA(S)≤600 ∨ AREA(S)≥1800 THEN RETURN;

α POLYGONS PERMETER;
	V ← V0 ← SON(PGN);
	AIVECT(MAG*(COL(V)-144),MAG*(108-ROW(V)));
	DO BEGIN
		V ← CCW(V);
		AVECT(MAG*(COL(V)-144),MAG*(108-ROW(V)));
	END UNTIL V=V0;

END "PDPY";
SUBR FLMDPY;			α FILM DISPLAY;
BEGIN "FLMDPY"
	ITG F,I0,I;
	ITG L0,L,P0,P;

	DPYSET(DPYBUF);
	AIVECT(-511,-MAG*108);
	 AVECT(+511,-MAG*108);
	 AVECT(+511,+MAG*108);
	 AVECT(-511,+MAG*108);
	 AVECT(-511,-MAG*108);

	F ← 0;
	I0 ← I ← SON(F);
DO BEGIN "IMGDPY"		α IMAGE DISPLAY;
	L0 ← L ← SON(I);
	L ← CCW(L);
	P0 ← P ← SON(L);
	DO PDPY(P) UNTIL P0=(P←CCW(P));
END "IMGDPY" UNTIL I0=(I←CCW(I));
	DPYOUT(0);
END "FLMDPY";
α INPUT CRE NODES;
	NODE[0] ← SIZE;
	ARRYIN(1,NODE[1],SIZE-1);
	ORIG ← LOCATION(NODE[0]);
	RELEASE(1);
	OUTSTR(9&"EOF."&↓);

α DISPLAY THE CRE FILM;
	FLMDPY;
	WHILE TRUE DO INCHRW;

END "MAIN";
END "TMP";